home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / windows / wnfond13.zip / WINFOND.PAS < prev    next >
Pascal/Delphi Source File  |  1996-08-16  |  4KB  |  179 lines
  1. program winfond;
  2. {$R WINFOND.RES}
  3. {$I-}
  4. {$M 8192,8192}
  5. uses strings,win31,winprocs,wintypes,Windos;
  6. CONST NBIM = 200;
  7. var Tablo : array[1..NBIM] of string[120];
  8.      valeur,max,compt : integer;
  9.      erreur,fichier,nom,actu,comp1,comp2 : string;
  10.     fin : boolean;
  11.     f : text;
  12.     asciiz,asciiz2,asciiz3 : array[0..80] of char;
  13.     ou,au,texte : Pchar;
  14.     chaine : string[80];
  15.     size : word;
  16.  
  17. label stop;
  18.  
  19. Function majuscule(phrase : string) : string;
  20.  var texte : array[0..255] of char;
  21.      pointe : Pchar;
  22. begin
  23. pointe:=@texte;
  24. StrPCopy(pointe,phrase);
  25. majuscule:=Strpas(AnsiUpper(pointe));
  26. end;
  27.  
  28. Procedure AllInRep(chaine : string; var i : integer);
  29. var result : TSearchRec;
  30.     recherche,pointe : Pchar;
  31.     test : array[1..120] of Char;
  32.     chemin : string;
  33. Begin
  34. recherche:=@test;
  35. chemin:=copy(chaine,1,length(chaine)-5);
  36. StrPcopy(recherche,chaine);
  37. FindFirst(recherche,faAnyFile,result); {recherche du premier .BMP}
  38. If DosError=0 then
  39.    begin
  40.    pointe:=@result.name;
  41.    Tablo[i]:=chemin+StrPas(pointe);
  42.    end;
  43. while DosError = 0 do     {arrΩt en cas d'erreur ou en cas de 18 -> Plus de fichiers}
  44.    begin
  45.    FindNext(result);      {recherche du .BMP suivant}
  46.    if DosError = 0 then
  47.       begin
  48.       i:=i+1;
  49.       pointe:=@result.name;
  50.       Tablo[i]:=chemin+StrPas(pointe);   {Tablo[i] se remplit avec les noms trouvΘs}
  51.       end;
  52.    end;
  53. If (DosError<>0) and (DosError<>18) Then
  54.    erreur:='Erreur dans l''utilisation de *.BMP';
  55.  
  56. end;
  57.  
  58. Procedure Lire(fichier : string);
  59. var f: text;
  60.      i : integer;
  61.     chaine : string;
  62.     test : string;
  63. begin
  64. i:=0;
  65. Assign(f,fichier);
  66. Reset(f);
  67. chaine:='';
  68. Repeat
  69. i:=i+1;
  70. Readln(f,chaine);
  71. test:=copy(chaine,length(chaine)-4,5);
  72. if (majuscule(test)='*.BMP')
  73.    then AllInRep(chaine,i)  {AllInRep permet de trouver tous les .BMP d'un rep.}
  74.    else Tablo[i]:=chaine;
  75. until Eof(f);
  76. Close(f);
  77. end;
  78.  
  79. {
  80. La fonction IsAFile vΘrifie qu'il
  81. s'agit d'un fichier en l'ouvrant
  82. et en vΘrifiant que tout va bien
  83. (ioresult=0)
  84. }
  85. Function IsAFile(chaine : string) : boolean;
  86. var fich : file;
  87. begin
  88. IsAFile:=FALSE;
  89. assign(fich,chaine);
  90. if ioresult<>0
  91. then IsAFile:=FALSE
  92. else
  93.     begin
  94.     reset(fich,1);
  95.     if ioresult<>0
  96.     then
  97.         IsAFile:=FALSE
  98.     else
  99.         begin
  100.         IsAFile:=TRUE;
  101.         close(fich);
  102.         end;
  103.     end;
  104. end;
  105.  
  106. Function IsBMP(chaine : string) : boolean;
  107. const BMP=19778;
  108. var fich : file;
  109.      tipe : word;
  110.      taille : longint;
  111. begin
  112. IsBMP:=FALSE;
  113. assign(fich,chaine);
  114. if ioresult<>0
  115. then IsBMP:=FALSE
  116. else
  117.     begin
  118.     reset(fich,1);
  119.     if ioresult<>0
  120.     then
  121.         IsBMP:=FALSE
  122.     else
  123.         begin
  124.         Blockread(fich,tipe,2);
  125.         if (tipe=BMP)
  126.       and (pos(' ',chaine)=0)
  127.             then Isbmp:=TRUE
  128.             else IsBMP:=FALSE;
  129.         close(fich);
  130.         end;
  131.     end;
  132. end;
  133.  
  134. BEGIN
  135. randomize;
  136. for compt:=1 to NBIM do
  137. Tablo[compt]:='';
  138. fichier:='';
  139. valeur:=-1;
  140. erreur:='RIEN';
  141. if paramcount=1
  142.    then fichier:=paramstr(1)
  143.    else begin
  144.         if paramcount>1 then erreur:='Too many parameters';
  145.         if paramcount<1 then erreur:='Not enough parameters';
  146.         goto stop;
  147.         end;
  148. if IsAFile(fichier)
  149.    then Lire(fichier)
  150.    else begin erreur:='File not found: "'+fichier+'"'; goto stop; end;
  151. for compt:=1 to NBIM do
  152. if Tablo[compt]<>'' then max:=compt;
  153. for compt:=1 to max do
  154.  
  155. fin:=FALSE;
  156.  
  157. {recupere le nom precedent et le stocke dans actu}
  158. comp1:='Franτois CREVOLA'; comp2:='';
  159. ou:=@asciiz;               au:=@asciiz2;
  160. StrPCopy(ou,comp1);        StrPCopy(au,comp2);
  161. {                              returned---\       }
  162. GetProfileString('Desktop','Wallpaper',ou,au,80);
  163. actu:=strpas(au);
  164.  
  165. repeat
  166. Nom:=tablo[random(max)+1];
  167. until (nom<>actu);
  168. if (IsBMP(nom)=FALSE) then begin erreur:='"'+nom+'" is not a BMP'; goto stop; end else erreur:='RIEN';
  169. ou:=@asciiz;
  170. au:=@asciiz2;
  171. StrPCopy(ou,nom);
  172. StrPCopy(au,actu);                        
  173. WriteProfileString('Desktop', 'WallPaper', ou);
  174. SystemParametersInfo(SPI_SETDESKWALLPAPER,0,au,0);
  175. stop:
  176. texte:=@asciiz3;
  177. StrPcopy(texte,erreur+chr(13)+'( Help -> WINFOND.HLP )');
  178. if (erreur<>'RIEN') then valeur:=Messagebox(0,texte,'Winfond v1.3 - (c) Franτois CREVOLA 1996',mb_IconStop OR mb_OK);
  179. END.